Option Explicit Option Base 1 Sub About_Click () aboutForm.Show 1 End Sub Sub BinderyObjList_DblCLick () Dim Address As String Dim formatString As String Dim nwTime As String Dim YY, MM, DD, HR, MI, SC, DA As Integer Dim nwLoginTime As Variant Dim nwUser As USER_INFO Dim ccode, index As Integer nwUser = netWareUsers(BinderyObjList.ListIndex + 1) userName = Mid$(BinderyObjList.Text, 1, 20) userConn = nwUser.connNumber nwTime = nwUser.loginTime YY = Asc(Mid(nwTime, 1, 1)) + 1900 MM = Asc(Mid(nwTime, 2, 1)) DD = Asc(Mid(nwTime, 3, 1)) HR = Asc(Mid(nwTime, 4, 1)) MI = Asc(Mid(nwTime, 5, 1)) SC = Asc(Mid(nwTime, 6, 1)) 'pretty print the login time nwLoginTime = DateSerial(YY, MM, DD) formatString = Format$(nwLoginTime, "mm-dd-yyyy") userLoginTime = formatString 'pretty print the login date formatString = TimeSerial(HR, MI, SC) userLoginDay = formatString 'pretty print the internet address ccode = NWGetInternetAddress(nwConn, userConn, yourInetAddress) If ccode Then MsgBox "Error getting internet addresss" End If formatString = yourInetAddress.network & yourInetAddress.node FormatInternetAddress formatString userAddress = formatString userPicture.Visible = True Rem The following sets up the remote name, the network, node and socket (&h5454) spx1.RemoteName = yourInetAddress.network & yourInetAddress.node & Chr$(&H54) & Chr$(&H54) connectButton.SetFocus End Sub Sub BinderyObjList_KeyPress (KeyAscii As Integer) If KeyAscii = 13 Then BinderyObjList_DblCLick End If End Sub Sub cancelButton_Click () spx1.Status = 0 userPicture.Visible = False receiveList.Visible = False connectButton.Enabled = True disConnectButton.Enabled = False End Sub Sub connectButton_Click () If Mid$(spx1.LocalName, 1, 10) = Mid$(spx1.RemoteName, 1, 10) Then MsgBox "Unable to directory to yourself" Exit Sub End If receiveList.Clear spx1.Send = "DIR" End Sub Sub disconnectButton_Click () spx1.Status = 0 userPicture.Visible = False receiveList.Visible = False connectButton.Enabled = True disConnectButton.Enabled = False cancelButton.Enabled = True End Sub Sub exitButton_Click () End End Sub Sub Form_Load () Dim title, server, fileServerName As String Dim ccode, connID As Integer Dim s As String ccode = NWCallsInit(ByVal 0&, ByVal 0&) If ccode Then MsgBox "Unable to initialize NWCALLS.DLL" End End If spx1.LinkType = 1 'REM This is the default anyway Screen.MousePointer = 11 'change mouse cursor to hourglass server = String$(48, 0) server = GetConnections() ScanUsers server 'scan the bindery of the default server ServerNameBox.Selected(0) = True BinderyObjList.Selected(0) = True End Sub Sub FormatInternetAddress (inString) Dim nwString, outString As String Dim index As Integer 'Pretty printing for the hexidecimal network and node addresses outString = "[" nwString = Mid$(inString, 1, 4) For index = 1 To Len(nwString) outString = outString & Format$(Hex$(Asc(Mid$(nwString, index, 1))), "00") Next index outString = outString & "][" nwString = Mid$(inString, 5, 6) For index = 1 To Len(nwString) outString = outString & Format$(Hex$(Asc(Mid$(nwString, index, 1))), "00") Next index outString = outString & "]" inString = outString End Sub Function GetConnections () As String Dim connID As Integer Dim fileServerName As String Dim ccode, mode, connListSize As Integer Dim numConnections As Integer ReDim connListBuffer(50) As Integer ServerNameBox.Clear mode = 0 connListSize = 50 ccode = NWGetConnectionList(mode, connListBuffer(1), connListSize, numConnections) For connID = 1 To numConnections 'for each connection in workstation's file server name table 'get the table entry, then see if it's null fileServerName = String$(48, 0) NWGetFileServerName connID, fileServerName If Left$(fileServerName, 1) <> Chr$(0) Then 'you have to explicitly look for a null in the first character, 'because Visual Basic doesn't know about null-terminated strings '(a null prints as a space) If connID = 1 Then GetConnections = fileServerName ServerNameBox.AddItem fileServerName End If Next connID End Function Sub Rescan_Click () ServerNameBox_DblClick 'same effect as if the user had 'double-clicked on a file server name End Sub Sub RescanButton_Click () Dim server As String server = GetConnections() ServerNameBox_DblClick 'same effect as if the user had 'double-clicked on a file server name End Sub Sub ScanUsers (server) Dim objectType As String * 6 Dim maxConns As Long Dim ccode As Integer Dim index As Integer Dim nIndex As Integer Dim nwUser As USER_INFO Dim objectName As String * 48 Screen.MousePointer = 11 'change mouse cursor to hourglass BinderyObjList.Clear ccode = NWGetConnectionHandle(server, ByVal 0, nwConn, ByVal 0&) 'get the connection handle to our default server If (ccode) Then MsgBox "Unable to get connection" Exit Sub End End If ccode = NWGetConnectionNumber(nwConn, nwConnNumber) 'and get the connection number If (ccode) Then MsgBox "Unable to get connection number" Exit Sub End End If ccode = NWGetInternetAddress(nwConn, nwConnNumber, myInetAddress) Rem myInetAddress = spx1.LocalName ' get our internet address and put it in a global for use later If (ccode) Then MsgBox "Unable to get internet address" Exit Sub End End If ccode = NWGetFileServerInformation(nwConn, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, maxConns, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&) ' get the maximum number of connections the file server has used If (ccode) Then Exit Sub End If ReDim netWareUsers(maxConns) nIndex = 1 'loop through all the possible connection numbers to get 'all the logged in users For index = 1 To maxConns ccode = NWGetConnectionInformation(nwConn, index, ByVal nwUser.objectName, nwUser.objectType, nwUser.objectID, ByVal nwUser.loginTime) If ccode = 0 And Left$(nwUser.objectName, 1) <> Chr$(0) Then BinderyObjList.AddItem nwUser.objectName nwUser.connNumber = index netWareUsers(nIndex) = nwUser nIndex = nIndex + 1 End If DoEvents Next index EndConns: Screen.MousePointer = 0 'change mouse cursor back to how it was End Sub Sub ServerNameBox_DblClick () Dim server, prefServer As String Dim index, ccode, connID As Integer prefServer = ServerNameBox.Text If Len(prefServer) = 0 Then Rem no server selected prefServer = ServerNameBox.List(0) End If server = GetConnections() ScanUsers prefServer 'then go scan its bindery index = SendMessage(ServerNameBox.hWnd, LB_FINDSTRING, ByVal -1, ByVal prefServer) If (index <> LB_ERR) Then ServerNameBox.Selected(index) = True Else ServerNameBox.Selected(0) = True End If BinderyObjList.Selected(0) = True End Sub Sub spx1_LinkEvent () If spx1.Event Then MsgBox "Link Error: " & spx1.Event Exit Sub End If End Sub Sub spx1_ReceiveData () receiveList.Visible = True disConnectButton.Enabled = True connectButton.Enabled = False receiveList.AddItem spx1.Received End Sub Sub spx1_SendData () 'Fired when the packet has been sent End Sub Sub userPictureDrop_DblClick () aboutForm.Show 1 End Sub